home *** CD-ROM | disk | FTP | other *** search
- unit RFMain;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, Registry, ComCtrls;
-
- type
- TForm1 = class(TForm)
- ListBox1: TListBox;
- FileTypesLabel: TLabel;
- HeaderControl1: THeaderControl;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
- procedure HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
- procedure ListBox1DblClick(Sender: TObject);
- procedure HeaderControl1SectionClick(HeaderControl: THeaderControl; Section: THeaderSection);
- procedure ListBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- private
- { Private declarations }
- SysReg: TRegIniFile; { For accessing system registry }
- ShowDesc: Boolean; { True for descriptions, False for associations }
- HeaderZeroSize: Integer; { A little hackette for on-the-fly header resizing }
- function GetStr (S: String; Idx: Integer): String;
- procedure DeleteItem (const ItemString: String);
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- function TForm1.GetStr (S: String; Idx: Integer): String;
- var
- IdxPos: Integer;
- begin
- while Idx <> 0 do begin
- IdxPos := Pos (Chr (9), S);
- S := Copy (S, IdxPos + 1, MaxInt);
- Dec (Idx);
- end;
-
- IdxPos := Pos (Chr (9), S);
- if IdxPos = 0 then IdxPos := MaxInt;
- Result := Copy (S, 1, IdxPos - 1);
- end;
-
- procedure TForm1.FormCreate(Sender: TObject);
- var
- Idx: Integer;
- Desc, Str, CurSubKeyName: String;
- SubKeys, FileExts: TStringList;
- begin
- { Open the registry and access the hKey_Classes_Root hive }
- SysReg := TRegIniFile.Create ('');
- SysReg.RootKey := hKey_Classes_Root;
- SysReg.OpenKey ('', False);
-
- { Create a temporary stringlist for holding raw subkey names }
- SubKeys := TStringList.Create;
-
- { And another for holding tab-delimited file extensions }
- FileExts := TStringList.Create;
- try
- SysReg.ReadSections (SubKeys);
- for Idx := SubKeys.Count - 1 downto 0 do begin
- CurSubKeyName := SubKeys [Idx];
- if CurSubKeyName [1] = '.' then begin
- Str := SysReg.ReadString (CurSubKeyName, '', '');
- if Str <> '' then begin
- Desc := SysReg.ReadString (Str, '', '');
- if Desc <> '' then begin
- Str := SysReg.ReadString (Str + '\shell\open\command', '', '');
- if Str <> '' then FileExts.Add (CurSubKeyName + Chr(9) + Desc + Chr(9) + Str);
- end;
- end;
- end;
- end;
-
- ListBox1.Items.Assign (FileExts);
- ListBox1.ItemIndex := 0;
- FileTypesLabel.Caption := Format ('Registered File &Count = %d', [ListBox1.Items.Count]);
- finally
- SubKeys.Free;
- FileExts.Free;
- end;
-
- ShowDesc := True;
- HeaderZeroSize := HeaderControl1.Sections [0].Width;
- end;
-
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- SysReg.Destroy;
- end;
-
- procedure TForm1.ListBox1DrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
- var
- Idx: Integer;
- ItemString: String;
- begin
- with ListBox1.Canvas do begin
- FillRect (Rect);
- if odSelected in State then Font.Style := Font.Style + [fsBold];
-
- ItemString := ListBox1.Items [Index];
- TextOut (Rect.Left + 5, Rect.Top, GetStr (ItemString, 0));
- if ShowDesc then Idx := 1 else Idx := 2;
- TextOut (HeaderZeroSize, Rect.Top, GetStr (ItemString, Idx));
- end;
- end;
-
- procedure TForm1.HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
- begin
- if State = tsTrackMove then begin
- HeaderZeroSize := Width;
- ListBox1.Invalidate;
- end;
- end;
-
- procedure TForm1.HeaderControl1SectionClick (HeaderControl: THeaderControl; Section: THeaderSection);
- begin
- if Section = HeaderControl1.Sections [1] then begin
- ShowDesc := not ShowDesc;
- if ShowDesc then Section.Text := 'File Description' else Section.Text := 'File Association';
- ListBox1.Invalidate;
- end;
- end;
-
- procedure TForm1.DeleteItem (const ItemString: String);
- begin
- with ListBox1 do begin
- Items.Delete (ItemIndex);
- ItemIndex := 0;
- FileTypesLabel.Caption := Format ('Registered File &Count = %d', [ListBox1.Items.Count]);
- { Now delete the registry stuff too }
- SysReg.EraseSection (SysReg.ReadString (GetStr (ItemString, 0), '', ''));
- SysReg.EraseSection (GetStr (ItemString, 0));
- end;
- end;
-
- procedure TForm1.ListBox1KeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
- var
- ItemString: String;
- begin
- if Key = vk_Delete then with ListBox1 do begin
- ItemString := Items [ItemIndex];
- if MessageDlg (Format ('Remove all registry entries for ''%s''?',
- [GetStr (ItemString, 0)]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
- DeleteItem (ItemString);
- end;
- end;
-
- procedure TForm1.ListBox1DblClick(Sender: TObject);
- begin
- ShowMessage ('Hi!');
- end;
-
- end.
-